home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / Tcl 6.2 / Xfmath.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-03-14  |  23.6 KB  |  878 lines
  1. #pragma segment Xfmath
  2.  
  3. /* 
  4.  * fmath.c --
  5.  *
  6.  *      Contains the TCL trig and floating point math functions.
  7.  *---------------------------------------------------------------------------
  8.  * Copyright 1991 Karl Lehenbauer and Mark Diekhans.
  9.  *
  10.  * Permission to use, copy, modify, and distribute this software and its
  11.  * documentation for any purpose and without fee is hereby granted, provided
  12.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  13.  * Mark Diekhans make no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without express or
  15.  * implied warranty.
  16.  */
  17.  
  18. #include <math.h>
  19. #include <sane.h>
  20. #include "tcl.h"
  21.  
  22. #define FALSE        0
  23. #define TRUE        1
  24.  
  25. #define CHECK_FP_ERROR()    \
  26.         ( testexception(INVALID | UNDERFLOW | OVERFLOW | DIVBYZERO) )
  27.  
  28. /*
  29.  * Flag used to indicate if a floating point math routine is currentlybeing
  30.  * execu-ed.  Used to determine if a fmatherr belongs to Tcl.
  31.  */
  32. static int G_inTclFPMath = FALSE;
  33.  
  34. /*
  35.  * Flag indicating if a floating point math error occured during the execution
  36.  * of a library routine called by a Tcl command.  Will not be set by the trap
  37.  * handler if the error did not occur while the `G_inTclFPMath' flag was
  38.  * set.  If the error did occur the error type and the name of the function
  39.  * that got the error are sa e here.
  40.  */
  41. static int   G_gotTclFPMathErr = FALSE;
  42. static char *G_functionName;
  43. static int   G_errorType;
  44.  
  45. /*
  46.  * Prototypes of internal functions.
  47.  */
  48. int
  49. Tcl_UnaryFloatFunction _ANSI_ARGS_((Tcl_Interp *interp,
  50.                                     int         argc,
  51.                                     char      **argv,
  52.                                     double (*function)()));
  53.  
  54.  
  55. /*
  56.  *----------------------------------------------------------------------
  57.  *
  58.  * ReturnFPMathError --
  59.  *    Routine to set an interpreter result to contain a floating point
  60.  * math error message.  Will clear the `G_gotTclFPMathErr' flag.
  61.  * This routine alays returns the value TCL_ERROR, so if can be called
  62.  * as the argument to `return'.
  63.  *
  64.  * Globals:
  65.  *   o G_gotTclFPMathErr (O) - Flag indicating an error occured, will be 
  66.  *     cleared.
  67.  *   o G_functionName (I) - Name of function that got the error.
  68.  *   o G_errorType (I) - Type of error that occured.
  69.  *----------------------------------------------------------------------
  70.  */
  71. static int
  72. ReturnFPMathError(interp)
  73.     Tcl_Interp *interp;
  74.     {
  75.     char *ers;
  76.  
  77.     if (testexception(INVALID))
  78.         ers = "INVALID";
  79.     else if (testexception(UNDERFLOW))
  80.         ers = "UNDERFLOW";
  81.     else if (testexception(OVERFLOW))
  82.         ers = "OVERFLOW";
  83.     else if (testexception(DIVBYZERO))
  84.         ers = "DIVBYZERO";
  85.     else if (testexception(INEXACT))
  86.         ers = "INEXACT";
  87.  
  88.     sprintf(interp->result, "%s: floating point %s error", G_functionName, ers);
  89.  
  90.     return TCL_ERROR;
  91.     }
  92.  
  93. /*
  94.  *----------------------------------------------------------------------
  95.  *
  96.  * Tcl_UnaryFloatFunction --
  97.  *    Helper routine that implements Tcl unary floating point
  98.  *     functions by validating parameters, converting the
  99.  *     argument, applying the function (the address of which
  100.  *     is passed as an argument), and converting the result to
  101.  *     a string and storing it in the result buffer
  102.  *
  103.  * Results:
  104.  *      Returns TCL_OK if number is present, conversion succeeded,
  105.  *        the function was performed, tc.
  106.  *      Return TCL_ERROR for any error; an appropriate error message
  107.  *        is placed in the result string in this case.
  108.  *
  109.  *----------------------------------------------------------------------
  110.  */
  111. static int
  112. Tcl_UnaryFloatFunction(interp, argc, argv, function)
  113.     Tcl_Interp *interp;
  114.     int         argc;
  115.     char      **argv;
  116.     double (*function)();
  117. {
  118.     double dbVal;
  119.  
  120.     G_functionName = argv[0];
  121.  
  122.     if (argc != 2) {
  123.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], " val",
  124.                           (char *) NULL);
  125.         return TCL_ERROR;
  126.     }
  127.  
  128.     if (Tcl_GetDouble (interp, argv[1], &dbVal) != TCL_OK)
  129.         return TCL_ERROR;
  130.  
  131.     G_inTclFPMath = TRUE;
  132.     sprintf(interp->result, "%g", (*function)(dbVal));
  133.     G_inTclFPMath = FALSE;
  134.  
  135.     if (CHECK_FP_ERROR())
  136.         return ReturnFPMathError (interp);
  137.  
  138.     return TCL_OK;
  139. }
  140. /*
  141.  *----------------------------------------------------------------------
  142.  *
  143.  * Tcl_StrToLong --
  144.  *      Convert an Ascii string to an long number of the specified base.
  145.  *
  146.  * Parameters:
  147.  *   o string (I) - String containing a number.
  148.  *   o base (I) - The base to use for the number 8, 10 or 16 or zero to decide
  149.  *     based on the leading characters of the number.  Zero to let the number
  150.  *     determine the base.
  151.  *   o longPtr (O) - Place to return the converted number.  Will be 
  152.  *     unchanged if there is an error.
  153.  *
  154.  * Returns:
  155.  *      Returns 1 if the string was a valid number, 0 invalid.
  156.  *----------------------------------------------------------------------
  157.  */
  158. int
  159. Tcl_StrToLong (string, base, longPtr)
  160.     CONST char *string;
  161.     int         base;
  162.     long       *longPtr;
  163. {
  164.     char *end;
  165.     long  num;
  166.  
  167.     num = strtol(string, &end, base);
  168.     while ((*end != '\0') && isspace(*end)) {
  169.         end++;
  170.     }
  171.     if ((end == string) || (*end != 0))
  172.         return FALSE;
  173.     *longPtr = num;
  174.     return TRUE;
  175.  
  176. } /* Tcl_StrToLong */
  177.  
  178. /*
  179.  *----------------------------------------------------------------------
  180.  *
  181.  * Tcl_StrToInt --
  182.  *      Convert an Ascii string to n number of the specified base.
  183.  *
  184.  * Paramet-rs:
  185.  *   o string (I) - String containing a number.
  186.  *   o base (I) - The base to use for the number 8, 10 or 16 or zero to decide
  187.  *     based on the leading characters of the number.  Zero to let the number
  188.  *     det-rmine the base.
  189.  *   o intPtr (O) - Place to return the converted number.  Will be 
  190.  *     unchanged if there is an error.
  191.  *
  192.  * Returns:
  193.  *      Returns 1 if the string was a valid number, 0 invalid.
  194.  *----------------------------------------------------------------------
  195.  */
  196. int
  197. Tcl_StrToInt (string, base, intPtr)
  198.     CONST char *string;
  199.     int         base;
  200.     int        *intPtr;
  201. {
  202.     char *end;
  203.     int   num;
  204.  
  205.     num = strtol(string, &end, base);
  206.     while ((*end != '\0') && isspace(*end)) {
  207.         end++;
  208.     }
  209.     if ((end == string) || (*end != 0))
  210.         return FALSE;
  211.     *intPtr =-num;
  212.     return TRUE;
  213.  
  214. } /* Tcl_StrToInt */
  215.  
  216. /*
  217.  *----------------------------------------------------------------------
  218.  *
  219.  * Tcl_StrToUnsigned --
  220.  *      Convert an Ascii string to an unsigned int of the specified base.
  221.  *
  222.  * Parameters:
  223.  *   o string (I) - String containing a number.
  224.  *   o base (I) - The base to use for the number 8, 10 or 16 or zero to decide
  225.  *     based on the-leading characters of the number.  Zero to let the number
  226.  *     determine the base.
  227.  *   o unsignedPtr (O) - Place to return the converted number.  Will be 
  228.  *     unchanged if there is an error.
  229.  *
  230.  * Returns:
  231.  *      Returns 1 if the string was a valid number, 0 invalid.
  232.  *----------------------------------------------------------------------
  233.  */
  234. int
  235. Tcl_StrToUnsigned (string, base, unsignedPtr)
  236.     CONST char *string;
  237.     int         base;
  238.     unsigned   *unsignedPtr;
  239. {
  240.     char          *end;
  241.     unsigned long  num;
  242.  
  243.     num = strtoul (string, &end, base);
  244.     while ((*end != '\0') && isspace(*end)) {
  245.         end++;
  246.     }
  247.     if ((end == string) || (*end != 0))
  248.         return FALSE;
  249.     *unsignedPtr = num;
  250.     return TRUE;
  251.  
  252. } /* Tcl_StrToUnsigned */
  253.  
  254. /*
  255.  *----------------------------------------------------------------------
  256.  *
  257.  * Tcl_StrToDouble --
  258.  *   Convert a string to a double percision floating point number.
  259.  *
  260.  * Parameters:
  261.  *   string (I) - Buffer containing double value to convert.
  262.  *   doubleP-r (O) - The convert floating point number.
  263.  * Returns:
  264.  *   TRUE if the number is ok, FALSE if it is illegal.
  265.  *-----------------------------------------------------------------------------
  266.  */
  267. int
  268. Tcl_StrToDouble (string, doublePtr)
  269.     CONST char *string;
  270.     double     *doublePtr;
  271. {
  272.     char   *end;
  273.     double  num;
  274.  
  275.     num = strtod (string, &end);
  276.     while ((*end != '\0') && isspace(*end)) {
  277.         end++;
  278.     }
  279.     if ((end == string) || (*end != 0))
  280.         return FALSE;
  281.  
  282.     *doublePtr = num;
  283.     return TRUE;
  284.  
  285. } /* Tcl_StrToDouble */
  286.  
  287. /*
  288.  *----------------------------------------------------------------------
  289.  *
  290.  * Tcl_DownShift --
  291.  *     Utility procedure to down-shift a string.  It is written in such
  292.  *     a wa as that the target string maybe the same as the source string.
  293.  *
  294.  * Parameters:
  295.  *   o targetStr (I) - String to store the down-shifted string in.  Must
  296.  *     have enough space allocated to store the string.  If NULL is specified,
  297.  *     then the string will be dynamicly allocated and returned as the
  298.  *     result of the function. May also be the same as the source string to
  299.  *     shift in place.
  300.  *   o sourceStr (I) - The string to down-shift.
  301.  *
  302.  * Returns:
  303.  *   A pointer to the down-shifted string
  304.  *----------------------------------------------------------------------
  305.  */
  306. char *
  307. Tcl_DownShift (targetStr, sourceStr)
  308.     char       *targetStr;
  309.     CONST char *sourceStr;
  310. {
  311.     register char theChar;
  312.     extern char *malloc();
  313.     
  314.     if (targetStr == NULL)
  315.         targetStr = ckalloc (strlen ((char *) sourceStr) + 1);
  316.  
  317.     for (; (theChar = *sourceStr) != '\0'; sourceStr++) {
  318.         if (isupper (theChar))
  319.             theChar = tolower (theChar);
  320.         *targetStr++ = theChar;
  321.     }
  322.     *targetStr = '\0';
  323.     return targetStr;
  324. }
  325.  
  326. /*
  327.  *----------------------------------------------------------------------
  328.  *
  329.  * Tcl_UpShift --
  330.  *     Utility procedure to up-shift a string.
  331.  *
  332.  * Parameters:
  333.  *   o targetStr (I) - String to store the up-shifted string in.  Must
  334.  *     have enough space allocated to store the string.  If NULL is specified,
  335.  *     then the string will be dynamicly allocated and returned as the
  336.  *     result of the function. May also be the same as the source string to
  337.  *     shift in place.
  338.  *   o sourceStr (I) - The string to up-shift.
  339.  *
  340.  * Returns:
  341.  *   A pointer to the up-shifted string
  342.  *----------------------------------------------------------------------
  343.  */
  344. char *
  345. Tcl_UpShift (targetStr, sourceStr)
  346.     char       *targetStr;
  347.     CONST char *sourceStr;
  348. {
  349.     register char theChar;
  350.     extern char *malloc();
  351.     
  352.     if (targetStr == NULL)
  353.         targetStr = ckalloc (strlen ((char *) sourceStr) + 1);
  354.  
  355.    for (; (theChar = *sourceStr) != '\0'; sourceStr++) {
  356.         if (islower (theChar))
  357.             theChar = toupper (theChar);
  358.         *targetStr++ = theChar;
  359.     }
  360.     *targetStr = '\0';
  361.     return targetStr;
  362. }
  363.  
  364. /*
  365.  *----------------------------------------------------------------------
  366.  *
  367.  * Tcl_AcosCmd --
  368.  *    Implements the TCL arccosine command:
  369.  *        acos num
  370.  *
  371.  * Results:
  372.  *      Returns TCL_OK if number is present and conversion succeeds.
  373.  *
  374.  *----------------------------------------------------------------------
  375.  */
  376. int
  377. Tcl_AcosCmd(clientData, interp, argc, argv)
  378.     ClientData  clientData;
  379.     Tcl_Interp *interp;
  380.     int         argc;
  381.     char      **argv;
  382. {
  383.     return Tcl_UnaryFloatFunction(interp, argc, argv, acos);
  384. }
  385.  
  386. /*
  387.  *----------------------------------------------------------------------
  388.  *
  389.  * Tcl_AsinCmd --
  390.  *    Implements the TCL arcsin command:
  391.  *        asin num
  392.  *
  393.  * Results:
  394.  *      Returns TCL_OK if number is present and conversion succeeds.
  395.  *
  396.  *----------------------------------------------------------------------
  397.  */
  398. int
  399. Tcl_AsinCmd(clientData, interp, argc, argv)
  400.     ClientData  clientData;
  401.     Tcl_Interp *interp;
  402.     int         argc;
  403.     char      **argv;
  404. {
  405.     return Tcl_UnaryFloatFunction(interp, argc, argv, asin);
  406. }
  407.  
  408. /*
  409.  *----------------------------------------------------------------------
  410.  *
  411.  * Tcl_AtanCmd --
  412.  *    Implements the TCL arctangent command:
  413.  *        atan num
  414.  *
  415.  * Results:
  416.  *      Returns TCL_OK if number is present and conversion succeeds.
  417.  *
  418.  *----------------------------------------------------------------------
  419.  */
  420. int
  421. Tcl_AtanCmd(clientData, interp, argc, argv)
  422.     ClientData  clientData;
  423.     Tcl_Interp *interp;
  424.     int         argc;
  425.     char      **argv;
  426. {
  427.     return Tcl_UnaryFloatFunction(interp, argc, argv, atan);
  428. }
  429.  
  430. /*
  431.  *----------------------------------------------------------------------
  432.  *
  433.  * Tcl_CosCmd --
  434.  *    Implements the TCL cosine command:
  435.  *        cos num
  436.  *
  437.  * Results:
  438.  *      Returns TCL_OK if number is present and conversion succeeds.
  439.  *
  440.  *----------------------------------------------------------------------
  441.  */
  442. int
  443. Tcl_CosCmd(clientData, interp, argc, argv)
  444.     ClientData  clientData;
  445.     Tcl_Interp *interp;
  446.     int         argc;
  447.     char      **argv;
  448. {
  449.     return Tcl_UnaryFloatFunction(interp, argc, argv, cos);
  450. }
  451.  
  452. /*
  453.  *----------------------------------------------------------------------
  454.  *
  455.  * Tcl_SinCmd --
  456.  *    Implements the TCL sin command:
  457.  *        sin num
  458.  *
  459.  * Results:
  460.  *      Returns TCL_OK if number is present and conversion succeeds.
  461.  *
  462.  *----------------------------------------------------------------------
  463.  */
  464. int
  465. Tcl_SinCmd(clientData, interp, argc, argv)
  466.     ClientData  clientData;
  467.     Tcl_Interp *interp;
  468.     int         argc;
  469.     char      **argv;
  470. {
  471.     return Tcl_UnaryFloatFunction(interp, argc, argv, sin);
  472. }
  473.  
  474. /*
  475.  *----------------------------------------------------------------------
  476.  *
  477.  * Tcl_TanCmd --
  478.  *    Implements the TCL tangent command:
  479.  *        tan num
  480.  *
  481.  * Results:
  482.  *      Returns TCL_OK if number is present and conversion succeeds.
  483.  *
  484.  *----------------------------------------------------------------------
  485.  */
  486. int
  487. Tcl_TanCmd(clientData, interp, argc, argv)
  488.     ClientData  clientData;
  489.     Tcl_Interp *interp;
  490.     int         argc;
  491.     char      **argv;
  492. {
  493.     return Tcl_UnaryFloatFunction(interp, argc, argv, tan);
  494. }
  495.  
  496. /*
  497.  *----------------------------------------------------------------------
  498.  *
  499.  * Tcl_CoshCmd --
  500.  *    Implements the TCL hyperbolic cosine command:
  501.  *        cosh num
  502.  *
  503.  * Results:
  504.  *      Returns TCL_OK if number is present and conversion succeeds.
  505.  *
  506.  *----------------------------------------------------------------------
  507.  */
  508. int
  509. Tcl_CoshCmd(clientData, interp, argc, argv)
  510.     ClientData  clientData;
  511.     Tcl_Interp *interp;
  512.     int         argc;
  513.     char      **argv;
  514. {
  515.     return Tcl_UnaryFloatFunction(interp, argc, argv, cosh);
  516. }
  517.  
  518. /*
  519.  *----------------------------------------------------------------------
  520.  *
  521.  * Tcl_SinhCmd --
  522.  *    Implements the TCL hyperbolic sin command:
  523.  *        sinh num
  524.  *
  525.  * Results:
  526.  *      Returns TCL_OK if number is present and conversion succeeds.
  527.  *
  528.  *----------------------------------------------------------------------
  529.  */
  530. int
  531. Tcl_SinhCmd(clientData, interp, argc, argv)
  532.     ClientData  clientData;
  533.     Tcl_Interp *interp;
  534.     int         argc;
  535.     char      **argv;
  536. {
  537.     return Tcl_UnaryFloatFunction(interp, argc, argv, sinh);
  538. }
  539.  
  540. /*
  541.  *----------------------------------------------------------------------
  542.  *
  543.  * Tcl_TanhCmd --
  544.  *    Implements the TCL hyperbolic tangent command:
  545.  *        tanh num
  546.  *
  547.  * Results:
  548.  *      Returns TCL_OK if number is present and conversion succeeds.
  549.  *
  550.  *----------------------------------------------------------------------
  551.  */
  552. int
  553. Tcl_TanhCmd(clientData, interp, argc, argv)
  554.     ClientData  clientData;
  555.     Tcl_Interp *interp;
  556.     int         argc;
  557.     char      **argv;
  558. {
  559.     return Tcl_UnaryFloatFunction(interp, argc, argv, tanh);
  560. }
  561.  
  562. /*
  563.  *----------------------------------------------------------------------
  564.  *
  565.  * Tcl_ExpCmd --
  566.  *    Implements the TCL exponent command:
  567.  *        exp num
  568.  *
  569.  * Results:
  570.  *      Returns TCL_OK if number is present and conversion succeeds.
  571.  *
  572.  *----------------------------------------------------------------------
  573.  */
  574. int
  575. Tcl_ExpCmd(clientData, interp, argc, argv)
  576.     ClientData  clientData;
  577.     Tcl_Interp *interp;
  578.     int         argc;
  579.     char      **argv;
  580. {
  581.     return Tcl_UnaryFloatFunction(interp, argc, argv, exp);
  582. }
  583.  
  584. /*
  585.  *----------------------------------------------------------------------
  586.  *
  587.  * Tcl_LogCmd --
  588.  *    Implements the TCL logarithm command:
  589.  *        log num
  590.  *
  591.  * Results:
  592.  *      Returns TCL_OK if number is present and conversion succeeds.
  593.  *
  594.  *----------------------------------------------------------------------
  595.  */
  596. int
  597. Tcl_LogCmd(clientData, interp, argc, argv)
  598.     ClientData  clientData;
  599.     Tcl_Interp *interp;
  600.     int         argc;
  601.     char      **argv;
  602. {
  603.     return Tcl_UnaryFloatFunction(interp, argc, argv, log);
  604. }
  605.  
  606. /*
  607.  *----------------------------------------------------------------------
  608.  *
  609.  * Tcl_Log10Cmd --
  610.  *    Implements the TCL base-10 logarithm command:
  611.  *        log10 num
  612.  *
  613.  * Results:
  614.  *      Returns TCL_OK if number is present and conversion succeeds.
  615.  *
  616.  *----------------------------------------------------------------------
  617.  */
  618. int
  619. Tcl_Log10Cmd(clientData, interp, argc, argv)
  620.     ClientData  clientData;
  621.     Tcl_Interp *interp;
  622.     int         argc;
  623.     char      **argv;
  624. {
  625.     return Tcl_UnaryFloatFunction(interp, argc, argv, log10);
  626. }
  627.  
  628. /*
  629.  *----------------------------------------------------------------------
  630.  *
  631.  * Tcl_SqrtCmd --
  632.  *    Implements the TCL square root command:
  633.  *        sqrt num
  634.  *
  635.  * Results:
  636.  *      Returns TCL_OK if number is present and conversion succeeds.
  637.  *
  638.  *----------------------------------------------------------------------
  639.  */
  640. int
  641. Tcl_SqrtCmd(clientData, interp, argc, argv)
  642.     ClientData  clientData;
  643.     Tcl_Interp *interp;
  644.     int         argc;
  645.     char      **argv;
  646. {
  647.     return Tcl_UnaryFloatFunction(interp, argc, argv, sqrt);
  648. }
  649.  
  650. /*
  651.  *----------------------------------------------------------------------
  652.  *
  653.  * Tcl_FabsCmd --
  654.  *    Implements the TCL floating point absolute value command:
  655.  *        fabs num
  656.  *
  657.  * Results:
  658.  *      Returns TCL_OK if number is present and conversion succeeds.
  659.  *
  660.  *----------------------------------------------------------------------
  661.  */
  662. int
  663. Tcl_FabsCmd(clientData, interp, argc, argv)
  664.     ClientData  clientData;
  665.     Tcl_Interp *interp;
  666.     int         argc;
  667.     char      **argv;
  668. {
  669.     return Tcl_UnaryFloatFunction(interp, argc, argv, fabs);
  670. }
  671.  
  672. /*
  673.  *----------------------------------------------------------------------
  674.  *
  675.  * Tcl_FloorCmd --
  676.  *    Implements the TCL floor command:
  677.  *        floor num
  678.  *
  679.  * Resu-ts:
  680.  *      Returns TCL_OK if number is present and conversion succeeds.
  681.  *
  682.  *----------------------------------------------------------------------
  683.  */
  684. int
  685. Tcl_FloorCmd(clientData, interp, argc, argv)
  686.     ClientData  clientData;
  687.     Tcl_Interp *interp;
  688.     int         argc;
  689.     char      **argv;
  690. {
  691.     return Tcl_UnaryFloatFunction(interp, argc, argv, floor);
  692. }
  693.  
  694. /*
  695.  *----------------------------------------------------------------------
  696.  *
  697.  * Tcl_CeilCmd --
  698.  *    Implements the TCL ceil command:
  699.  *        ceil num
  700.  *
  701.  * Results:
  702.  *      Returns TCL_OK if number is present and conversion succeeds.
  703.  *
  704.  *----------------------------------------------------------------------
  705.  */
  706. int
  707. Tcl_CeilCmd(clientData, interp, argc, argv)
  708.     ClientData  clientData;
  709.     Tcl_Interp *interp;
  710.     int         argc;
  711.     char      **argv;
  712. {
  713.     return Tcl_UnaryFloatFunction(interp, argc, argv, ceil);
  714. }
  715.  
  716. /*
  717.  *----------------------------------------------------------------------
  718.  *
  719.  * Tcl_FmodCmd --
  720.  *    Implements the TCL floating modulo command:
  721.  *        fmod num1 num2
  722.  *
  723.  * Results:
  724.  *      Returns TCL_OK if number is present and conversion succeeds.
  725.  *
  726.  *----------------------------------------------------------------------
  727.  */
  728. int
  729. Tcl_FmodCmd(clientData, interp, argc, argv)
  730.     ClientData  clientData;
  731.     Tcl_Interp *interp;
  732.     int         argc;
  733.     char      **argv;
  734. {
  735.     double dbVal, dbDivisor;
  736.  
  737.     G_functionName = argv[0];
  738.  
  739.     if (argc != 3) {
  740.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], " val divisor",
  741.                           (char *) NULL);
  742.         return TCL_ERROR;
  743.     }
  744.  
  745.     if (Tcl_GetDouble (interp, argv[1], &dbVal) != TCL_OK)
  746.         return TCL_ERROR;
  747.  
  748.     if (Tcl_GetDouble (interp, argv[2], &dbDivisor) != TCL_OK)
  749.         return TCL_ERROR;
  750.  
  751.     G_inTclFPMath = TRUE;
  752.     sprintf(interp->result, "%g", fmod(dbVal,dbDivisor));
  753.     G_inTclFPMath = FALSE;
  754.  
  755.     if (CHECK_FP_ERROR())
  756.         return ReturnFPMathError (interp);
  757.  
  758.     return TCL_OK;
  759. }
  760.  
  761. /*
  762.  *----------------------------------------------------------------------
  763.  *
  764.  * Tcl_PowCmd --
  765.  *    Implements the TCL power (exponentiation) command:
  766.  *        pow num1 num2
  767.  *
  768.  * Results:
  769.  *      Returns TCL_OK if number is present and conversion succeeds.
  770.  *
  771.  *----------------------------------------------------------------------
  772.  */
  773. int
  774. Tcl_PowCmd(clientData, interp, argc, argv)
  775.     ClientData  clientData;
  776.     Tcl_Interp *interp;
  777.     int         argc;
  778.     char      **argv;
  779. {
  780.     double dbVal, dbExp;
  781.  
  782.     G_functionName = argv[0];
  783.  
  784.     if (argc != 3) {
  785.         Tcl_AppendResult (interp, "wrong # args: ", argv [0], " val exp",
  786.                           (char *) NULL);
  787.         return TCL_ERROR;
  788.     }
  789.  
  790.     if (Tcl_GetDouble (interp, argv[1], &dbVal) != TCL_OK)
  791.         return TCL_ERROR;
  792.  
  793.     if (Tcl_GetDouble (interp, argv[2], &dbExp) != TCL_OK)
  794.         return TCL_ERROR;
  795.  
  796.     G_inTclFPMath = TRUE;
  797.     sprintf(interp->result, "%g", pow(dbVal,dbExp));
  798.     G_inTclFPMath = FALSE;
  799.  
  800.     if (CHECK_FP_ERROR())
  801.         return ReturnFPMathError (interp);
  802.  
  803.     return TCL_OK;
  804. }
  805.  
  806. int
  807. Tcl_PiCmd(clientData, interp, argc, argv)
  808.     ClientData  clientData;
  809.     Tcl_Interp *interp;
  810.     int         argc;
  811.     char      **argv;
  812. {
  813.     strcpy(interp->result, "3.141592654");
  814.     return TCL_OK;
  815. }
  816.  
  817.  
  818. extern int Tcl_MaxCmd();
  819. extern int Tcl_MinCmd();
  820. extern int Tcl_RandomCmd();
  821.  
  822. Tcl_InitXmath(interp)
  823. Tcl_Interp    *interp;
  824. {
  825.     /*
  826.     ** from fmath.c
  827.     */
  828.     Tcl_CreateCommand(interp, "acos", Tcl_AcosCmd, 
  829.                      (ClientData)NULL, (void (*)())NULL);
  830.     Tcl_CreateCommand(interp, "asin", Tcl_AsinCmd, 
  831.                      (ClientData)NULL, (void (*)())NULL);
  832.     Tcl_CreateCommand(interp, "atan", Tcl_AtanCmd, 
  833.                      (ClientData)NULL, (void (*)())NULL);
  834.     Tcl_CreateCommand(interp, "cos", Tcl_CosCmd, 
  835.                      (ClientData)NULL, (void (*)())NULL);
  836.     Tcl_CreateCommand(interp, "sin", Tcl_SinCmd, 
  837.                      (ClientData)NULL, (void (*)())NULL);
  838.     Tcl_CreateCommand(interp, "tan", Tcl_TanCmd, 
  839.                      (ClientData)NULL, (void (*)())NULL);
  840.     Tcl_CreateCommand(interp, "cosh", Tcl_CoshCmd, 
  841.                      (ClientData)NULL, (void (*)())NULL);
  842.     Tcl_CreateCommand(interp, "sinh", Tcl_SinhCmd, 
  843.                      (ClientData)NULL, (void (*)())NULL);
  844.     Tcl_CreateCommand(interp, "tanh", Tcl_TanhCmd, 
  845.                      (ClientData)NULL, (void (*)())NULL);
  846.     Tcl_CreateCommand(interp, "exp", Tcl_ExpCmd, 
  847.                      (ClientData)NULL, (void (*)())NULL);
  848.     Tcl_CreateCommand(interp, "log", Tcl_LogCmd, 
  849.                      (ClientData)NULL, (void (*)())NULL);
  850.     Tcl_CreateCommand(interp, "log10", Tcl_Log10Cmd, 
  851.                      (ClientData)NULL, (void (*)())NULL);
  852.     Tcl_CreateCommand(interp, "sqrt", Tcl_SqrtCmd, 
  853.                      (ClientData)NULL, (void (*)())NULL);
  854.     Tcl_CreateCommand(interp, "fabs", Tcl_FabsCmd, 
  855.                      (ClientData)NULL, (void (*)())NULL);
  856.     Tcl_CreateCommand(interp, "floor", Tcl_FloorCmd, 
  857.                      (ClientData)NULL, (void (*)())NULL);
  858.     Tcl_CreateCommand(interp, "ceil", Tcl_CeilCmd, 
  859.                      (ClientData)NULL, (void (*)())NULL);
  860.     Tcl_CreateCommand(interp, "fmod", Tcl_FmodCmd, 
  861.                      (ClientData)NULL, (void (*)())NULL);
  862.     Tcl_CreateCommand(interp, "pow", Tcl_PowCmd, 
  863.                      (ClientData)NULL, (void (*)())NULL);
  864.     Tcl_CreateCommand(interp, "pi", Tcl_PiCmd, 
  865.                      (ClientData)NULL, (void (*)())NULL);
  866.  
  867.     /*
  868.      * from math.c
  869.      */
  870.     Tcl_CreateCommand (interp, "max", Tcl_MaxCmd, (ClientData)NULL, 
  871.              (void (*)())NULL);
  872.     Tcl_CreateCommand (interp, "min", Tcl_MinCmd, (ClientData)NULL, 
  873.              (void (*)())NULL);
  874.     Tcl_CreateCommand (interp, "random", Tcl_RandomCmd, (ClientData)NULL, 
  875.              (void (*)())NULL);
  876.  
  877.     }
  878.